home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / SWAG9605.DDD / 0019_A short FIRE routine.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-31  |  3.7 KB  |  148 lines
  1. (****************************************************************************
  2.  
  3. Hopefully you got this from SWAG :)
  4.  
  5. Anyways, this is my little fire routine that I wrote.  It didn't take me
  6.  
  7. very long and is far from being optimized... so it's kind of slow....
  8.  
  9. Runs fine on my pentium 100mhz though!!! :)
  10.  
  11.  
  12.  
  13. This code was written by Phire of Patd Programming.  Check out my homepage:
  14.  
  15. http://www.tripod.com/~rflynn  or email: rflynn@shelby.net
  16.  
  17. Please feel free to improve my code ;) 
  18.  
  19. (****************************************************************************)
  20.  
  21.  
  22.  
  23. USES CRT, DOS;
  24.  
  25.  
  26.  
  27. CONST
  28.  
  29.      YMAX = 50;
  30.      YMIN = 0;
  31.      XMAX = 317;
  32.      XMIN = 2;
  33.      maxc = 1;
  34.  
  35. VAR
  36.  
  37.    X,Y,Z  : WORD;
  38.    TOTAL  : WORD;
  39.    A,B,C  : LONGINT;
  40.    I      : WORD;
  41.    SCREEN : ARRAY[1..64000] OF BYTE;
  42.    ST, ET : REAL;
  43.    CYCLES : LONGINT;
  44.  
  45. PROCEDURE CT(VAR MOO:REAL);
  46. VAR
  47.    H,M,S,MS : WORD;
  48.  
  49. BEGIN
  50.      GETTIME(H,M,S,MS);
  51.      MOO:=H*3600+M*60+S+MS DIV 100;
  52. END;
  53.  
  54. procedure setcolor(color,r,g,b : byte);
  55. begin
  56.      port[$3c8]:=color;
  57.      port[$3c9]:=r;
  58.      port[$3c9]:=g;
  59.      port[$3c9]:=b;
  60. end;
  61. BEGIN
  62.      RANDOMIZE;
  63.      ASM MOV AX, 13H; INT 10H; END;
  64.      asm
  65.         mov dx, 03d4h
  66.         mov al, 9
  67.         out dx, al
  68.         inc dx
  69.         and al, 0e0h
  70.         or  al, 7
  71.         out dx, al
  72.      end;
  73.   for i:=0 to 63 do setcolor(i,0,0,0);
  74.   for i:=0 to 63 do setcolor(64+i,0,0,0);
  75.   for i:=0 to 63 do setcolor(128+i,i,i shr 1,0);
  76.   for i:=0 to 63 do setcolor(192+i,63,32+i shr 1,0);
  77.  
  78.   FILLCHAR(SCREEN, 64000, 0);
  79.  
  80.      WHILE KEYPRESSED DO READKEY;
  81.      CT(ST);
  82.      CYCLES:=0;
  83.      REPEAT
  84.            MOVE(SCREEN, MEM[$A000:0], 64000);
  85.            FOR Y:=YMAX DOWNTO YMIN DO
  86.            BEGIN
  87.                 IF Y=YMAX THEN
  88.                    BEGIN
  89.                         FOR Z:=XMIN TO XMAX DO
  90.                         BEGIN
  91.                              CASE RANDOM(10) OF
  92.                                   0,2,4 : SCREEN[Y*320+Z]:=0;
  93.                                   1,3,5,6,7,8,9 : SCREEN[Y*320+Z]:=255;
  94.                              END;
  95.                         END;
  96.                    END;
  97.  
  98.            FOR X:=XMIN TO XMAX DO
  99.                    BEGIN
  100.                         IF Y<YMAX THEN
  101.                            BEGIN
  102.                                 INC(CYCLES);
  103.                                 IF CYCLES=MAXC+1 THEN CYCLES:=0;
  104.                                 IF CYCLES=0 THEN
  105.                                 BEGIN
  106.                                 TOTAL:=0;
  107.                                 SCREEN[Y*320+X]:=SCREEN[(Y+1)*320+X];
  108.                                 TOTAL:=TOTAL+SCREEN[(Y+1)*320+(X-1)];
  109.                                 TOTAL:=TOTAL+SCREEN[(Y+1)*320+(X)];
  110.                                 TOTAL:=TOTAL+SCREEN[(Y+1)*320+(X+1)];
  111.                                 TOTAL:=TOTAL+SCREEN[(Y)*320+(X-1)];
  112.                                 TOTAL:=TOTAL+SCREEN[(Y)*320+(X)];
  113.                                 TOTAL:=TOTAL+SCREEN[(Y)*320+(X+1)];
  114.                                 A:=TOTAL DIV 6;
  115.                                 END;
  116.  
  117.                                 IF A>255 THEN A:=255;
  118.                                 SCREEN[Y*320+X]:=A;
  119.                                 SCREEN[Y*320+(X-1)]:=A;
  120.                                 SCREEN[Y*320+(X+1)]:=A;
  121.                            END;
  122.                    END;
  123.            END;
  124.      UNTIL (KEYPRESSED);
  125.      asm
  126.         mov ax, 3h
  127.         int 10h
  128.      end;
  129. END.
  130.  
  131.  
  132. { --- CUT --- }
  133.  
  134. (___)        *   Digital Patd/Patd Programming
  135.  
  136. (o o)-------/    EMAIL: rflynn@shelby.net
  137.  
  138.  \_/________|    WWW  : http://www.tripod.com/~rflynn
  139.  
  140.     ||    ||     SysOp Of Hot As Fire BBS!! {704}657-9498
  141.  
  142.     ^^    ^^     Call today or you might get burned!!!     
  143.  
  144.  
  145.  
  146.  
  147.  
  148.